home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0029_SETMODE5.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  107 lines
  1. {CD>     Can someone tell me how to get 320x200x256 screen mode in Turbo
  2. CD>Pascal 5.5.
  3.  
  4. Yes.
  5. }
  6. Program DemoMode13;
  7. Uses Dos,Crt;
  8. Var
  9.  LM : Word;
  10.  CD : Word;
  11.  
  12. {
  13. ; Enable 320*200*256, return True if successful, otherwise False
  14. ;
  15. ; Reasons For False return : Already in mode 13, mode 13 unsupported.
  16. }
  17. Function Enable13:Boolean;
  18.  Var
  19.   Regs : Registers;
  20.  begin
  21.   LM:=LastMode;
  22.   Regs.AH:=$0F;
  23.   intr($10,Regs);
  24.   if Regs.AL<>$13 then begin
  25.    Regs.AH:=$03;
  26.    intr($10,Regs);
  27.    CD:=Regs.CX;
  28.    Regs.AX:=$0013;
  29.    intr($10,Regs);
  30.    if (Regs.Flags and 1)=0 then begin
  31.     Enable13:=True;
  32.    end else begin
  33.     Enable13:=False;
  34.    end;
  35.   end else begin
  36.    Enable13:=False;
  37.   end;
  38.  end;
  39.  
  40. {
  41. ; Exit 310*200*256 mode, True if successful, False if not
  42. ;
  43. ; Reasons For False return : not in mode 13.
  44. }
  45. Function Release13:Boolean;
  46.  Var
  47.   Regs : Registers;
  48.  begin
  49.   Regs.AH:=$0F;
  50.   intr($10,Regs);
  51.   if Regs.AL=$13 then begin
  52.    TextMode(LM);
  53.    Regs.AH:=$01;
  54.    Regs.CX:=CD;
  55.    intr($10,Regs);
  56.    Release13:=True;
  57.   end else begin
  58.    Release13:=False;
  59.   end;
  60.  end;
  61.  
  62. {
  63. ; Plot a pixel in 320*200*256 mode.
  64. ;
  65. ; This may appear quite obvious at first, but take a closer look if you think
  66. ; it is Really simple.  if you read your Turbo Pascal book, though, you are
  67. ; required to only ponder the usage of `Absolute' For a moment.
  68. }
  69. Procedure DrawPixel(X,Y:Word;Colour:Byte);
  70.  Var
  71.   Screen : Array [0..319,0..199] of Byte Absolute $A000:$0000;
  72.  begin
  73.   Screen[Y,X]:=Colour;
  74.  end;
  75.  
  76. {
  77. ; Main Program.  Draws points in four corners in random colours, reads a like
  78. ; of Text (odd, but it displays it!) then returns to Text mode and quits.
  79. }
  80. begin
  81.  Writeln;
  82.  CheckBreak:=False;
  83.  CheckSnow:=False;
  84.  DirectVideo:=False;
  85.  if Enable13 then begin
  86.   Randomize;
  87.   DrawPixel(0,0,Random(255));
  88.   DrawPixel(319,0,Random(255));
  89.   DrawPixel(0,199,Random(255));
  90.   DrawPixel(319,199,Random(255));
  91.   GotoXY(1,2);
  92.   Writeln('Type something then press [Enter]');
  93.   readln;
  94.   if (not enable13) then begin
  95.    ClrScr;
  96.   end else begin
  97.    Writeln;
  98.    Writeln('Error Exiting mode 13.');
  99.    Writeln('Enter MODE CO80 or MODE MONO to');
  100.    Writeln('restore your screen to Text mode.');
  101.   end;
  102.  end else begin
  103.   Writeln('Error invoking mode 13');
  104.  end;
  105.  Writeln;
  106. end.
  107.